home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / COMAL / B-Book Series / (k)b2.d64 / correct < prev    next >
Text File  |  2007-02-28  |  4KB  |  164 lines
  1. 0010 //OLDHAM'S GRAMMAR SCHOOL//
  2. 0020 //PROGRAM TO ADMINISTER PUPILS' MARKS//
  3. 0030 //WRITTEN BY CHRIS BORGE IN CBM COMAL-80//
  4. 0040 //THIS VERSION: OCT. 1981//
  5. 0050 //THIS PART: TO MAKE CORRECTIONS //
  6. 0060 //
  7. 0070 MAX:=8
  8. 0080 DIM NAME$(MAX) OF 20, ANSW$ OF 10
  9. 0090 DIM THISNAME$ OF 20
  10. 0100 DIM MARK(MAX,3), SUBJ$(3) OF 10, KEY'(MAX)
  11. 0110 DIM SPACES$ OF 39
  12. 0120 //*
  13. 0130 SUBJ$(1):="ENGLISH"
  14. 0140 SUBJ$(2):="MATH"
  15. 0150 SUBJ$(3):="FRENCH"
  16. 0160 SPACES$(1:39):=""
  17. 0190 //
  18. 0200 STARTSYSTEM
  19. 0210 //
  20. 0220 //* MAINLINES *//
  21. 0230 REPEAT 
  22. 0240 CLEAR'SCREEN
  23. 0250 FIELD(8,15)
  24. 0260 PRINT "1=CORRECTIONS"
  25. 0270 PRINT "2=DELETE"
  26. 0280 PRINT "3=LOOKUP"
  27. 0290 PRINT "4=STOP"
  28. 0300 PRINT 
  29. 0310 INPUT "> ": JOBCODE
  30. 0320 IF JOBCODE=1 THEN CORRECTIONS
  31. 0330 IF JOBCODE=2 THEN ERASE
  32. 0340 IF JOBCODE=3 THEN LOOKUP
  33. 0350 IF JOBCODE=4 THEN STOPSYSTEM
  34. 0360 UNTIL FALSE
  35. 0370 //
  36. 0380 PROC CORRECTIONS 
  37. 0390 CLEAR'SCREEN
  38. 0400 TAKEIN("PUPILNO")
  39. 0410 DISPLAY
  40. 0420 INPUT "CORRECTIONS (YES/NO)? ": ANSW$
  41. 0430 IF ANSW$="YES" THEN
  42. 0440 TAKEIN("SUBJECT")
  43. 0450 TAKEIN("MARK")
  44. 0460 ENDIF 
  45. 0470 ENDPROC CORRECTIONS
  46. 0480 //
  47. 0490 PROC ERASE 
  48. 0500 CLEAR'SCREEN
  49. 0510 TAKEIN("PUPILNO")
  50. 0520 DISPLAY
  51. 0530 PRINT 
  52. 0540 PRINT "DO YOU WANT TO DELETE THE RECORD"
  53. 0550 PRINT "DISPLAYED ABOVE (YES/RETURN)",
  54. 0560 INPUT ANSW$
  55. 0570 IF ANSW$="YES" THEN NAME$(PUPILNO):=""
  56. 0580 ENDPROC ERASE
  57. 0590 //
  58. 0600 PROC TAKEIN(MATTER$) 
  59. 0610 REPEAT 
  60. 0620 FIELD(8,10)
  61. 0630 CASE MATTER$ OF
  62. 0640 WHEN "PUPILNO"
  63. 0650 INPUT "PUPIL NUMBER: ": PUPILNO
  64. 0660 WHEN "SUBJECT"
  65. 0670 PRINT "ENGLISH, MATH, FRENCH",
  66. 0680 INPUT ANSW$
  67. 0690 WHEN "MARK"
  68. 0700 PRINT "THE CORRECT MARK IN ",SUBJ$(SUBJNO)
  69. 0710 PRINT "FOR THE PUPIL ",NAME$(PUPILNO)," IS:",
  70. 0720 INPUT " ": THISMARK
  71. 0730 ENDCASE 
  72. 0740 CONTROL
  73. 0750 UNTIL OK
  74. 0760 CLEAR'SCREEN
  75. 0770 ENDPROC TAKEIN
  76. 0780 //
  77. 0790 PROC CONTROL 
  78. 0800 CASE MATTER$ OF
  79. 0810 WHEN "PUPILNO"
  80. 0820 EXISTS:=FALSE
  81. 0830 OK:=(0<PUPILNO AND PUPILNO<=MAX)
  82. 0840 IF OK THEN EXISTS:=(NAME$(PUPILNO)<>"")
  83. 0850 OK:=OK AND EXISTS
  84. 0860 WHEN "SUBJECT"
  85. 0870 I:=1
  86. 0880 WHILE ANSW$<>SUBJ$(I) AND I<3 DO I:=I+1
  87. 0890 OK:=(ANSW$=SUBJ$(I)); SUBJNO:=I
  88. 0900 WHEN "MARK"
  89. 0910 OK:=(0<=THISMARK AND THISMARK<=5)
  90. 0920 IF OK THEN MARK(PUPILNO,SUBJNO):=THISMARK
  91. 0930 ENDCASE 
  92. 0940 IF NOT OK THEN ERROR(4)
  93. 0950 ENDPROC CONTROL
  94. 0960 //
  95. 0970 PROC ERROR(NO) 
  96. 0980 FIELD(1,3)
  97. 0990 PRINT "ERROR!"
  98. 1000 //
  99. 1010 //NOT FINISHED//
  100. 1020 //
  101. 1030 ENDPROC ERROR
  102. 1040 //
  103. 1050 //
  104. 1060 PROC FIELD(L1,L2) 
  105. 1070 SCREEN(L1,1)
  106. 1080 FOR I:=1 TO L2-L1+1 DO PRINT SPACES$
  107. 1090 SCREEN(L1,1)
  108. 1100 PRINT 
  109. 1110 ENDPROC FIELD
  110. 1120 //
  111. 1130 PROC SCREEN(ROW,COL) CLOSED
  112. 1140 PRINT CHR$(19) //HOME
  113. 1150 FOR I:=1 TO ROW DO PRINT  //DOWN
  114. 1155 FOR I:=1 TO COL-1 DO PRINT CHR$(29), //RIGHT
  115. 1160 ENDPROC SCREEN
  116. 1170 //
  117. 1180 PROC STARTSYSTEM 
  118. 1190 OPEN FILE 2,"MARKBOOKS",READ
  119. 1200 FOR PUPILNO:=1 TO MAX DO
  120. 1210 READ FILE 2: NAME$(PUPILNO)
  121. 1220 FOR SUBJNO:=1 TO 3 DO READ FILE 2: MARK(PUPILNO,SUBJNO)
  122. 1230 ENDFOR PUPILNO
  123. 1240 CLOSE
  124. 1250 ENDPROC STARTSYSTEM
  125. 1260 //
  126. 1270 PROC STOPSYSTEM 
  127. 1280 OPEN FILE 2,"@0:MARKBOOKS",WRITE
  128. 1290 FOR PUPILNO:=1 TO MAX DO
  129. 1300 WRITE FILE 2: NAME$(PUPILNO)
  130. 1310 FOR SUBJNO:=1 TO 3 DO WRITE FILE 2: MARK(PUPILNO,SUBJNO)
  131. 1320 ENDFOR PUPILNO
  132. 1330 CLOSE
  133. 1340 STOP 
  134. 1350 ENDPROC STOPSYSTEM
  135. 1360 //
  136. 1370 PROC LOOKUP 
  137. 1380 CLEAR'SCREEN
  138. 1390 TAKEIN("PUPILNO")
  139. 1400 DISPLAY
  140. 1410 PRINT 
  141. 1420 INPUT "PRESS RETURN-KEY: ": ANSW$
  142. 1430 ENDPROC LOOKUP
  143. 1440 //
  144. 1450 PROC DISPLAY 
  145. 1460 CLEAR'SCREEN
  146. 1470 FIELD(8,20)
  147. 1480 IF NAME$(PUPILNO)<>"" THEN
  148. 1490 THISNAME$:=NAME$(PUPILNO)
  149. 1500 PRINT "PUPIL NUMBER ",PUPILNO,", ",THISNAME$
  150. 1510 PRINT "HAS ACHIEVED THE FOLLOWING RESULTS:"
  151. 1520 PRINT 
  152. 1530 FOR SUBJNO:=1 TO 3 DO
  153. 1540 PRINT SUBJ$(SUBJNO),": ",
  154. 1550 PRINT TAB(25),MARK(PUPILNO,SUBJNO)
  155. 1560 ENDFOR SUBJNO
  156. 1570 ENDIF 
  157. 1580 PRINT 
  158. 1590 ENDPROC DISPLAY
  159. 1600 //
  160. 1610 PROC CLEAR'SCREEN 
  161. 1620 PRINT CHR$(147),
  162. 1630 ENDPROC CLEAR'SCREEN
  163. 1640 //
  164.